﻿{*******************************************************}
{                                                       }
{       DelphiWebMVC                                    }
{       E-Mail:pearroom@yeah.net                        }
{       版权所有 (C) 2019 苏兴迎(PRSoft)                }
{                                                       }
{*******************************************************}
unit MVC.LogUnit;

interface

uses
  System.SysUtils,
  {$IFDEF MSWINDOWS}vcl.forms, Winapi.Windows, {$ENDIF}
  System.Classes, Web.HTTPApp, MVC.Tool;

type
  TLogThread = class(TThread)
  private
    procedure WriteMsg(msg: string);
  protected
    procedure Execute; override;
  public
    LogList: TStringList;
    logPath: string;
    constructor Create;
    destructor Destroy; override;
  end;

var
  logThread: TLogThread;

procedure Log(msg: string);

procedure LogE(msg: string);

procedure LogDebug(msg: string);

procedure WriteLog(msg: string);

implementation

uses
  MVC.Config;

procedure WriteLog(msg: string);
begin
  Lock(logThread.LogList);
  logThread.WriteMsg(msg);
  UnLock(logThread.LogList);
end;

procedure logE(msg: string);
begin
  Log('<Error> ' + msg + ' </Error>');
end;

procedure log(msg: string);
begin
  if config.open_log then
    logThread.LogList.Add(msg);
end;

procedure LogDebug(msg: string);
begin
{$IFDEF LOGDEBUG}
  logThread.LogList.Add(msg);
{$ENDIF}
end;

{ TLogTh }

constructor TLogThread.Create;
begin
  inherited Create(False);
  LogList := TStringList.Create;
  logPath := WebApplicationDirectory + 'Log/';
  logPath := IITool.PathFmt(logPath);
  if not DirectoryExists(logPath) then
  begin
    ForceDirectories(logPath);
  end;
end;

destructor TLogThread.Destroy;
begin
  LogList.Free;
  inherited;
end;

procedure TLogThread.Execute;
var
  k: Integer;
begin
  k := 0;
  while not Terminated do
  begin

    try
      Inc(k);
      if k >= 10 then
      begin
        k := 0;
        if LogList.Count > 0 then
        begin
          Lock(LogList);
          try
            if LogList.Count > 0 then
              WriteMsg(LogList.Strings[0]);
            LogList.Delete(0);
          finally
            UnLock(LogList);
          end;
        end;
      end;
    finally
      Sleep(10);
    end;
  end;
end;

procedure TLogThread.WriteMsg(msg: string);
var
  logfile: string;
  tf: TextFile;
begin
  try
    msg := FormatDateTime('hh:mm:ss.zzz', Now) + '  ' + msg;
    logfile := logPath + FormatDateTime('yyyyMMdd', Now) + '.log';
    AssignFile(tf, logfile,65001);  //utf8编码格式
    if FileExists(logfile) then
      Append(tf)
    else
    begin
     // Rewrite 过程能创建一个新文件并打开它，如果文件已经存在会对之前的文件进行覆盖
      Rewrite(tf);
    end;
    Writeln(tf, msg);
    Flush(tf);
  finally
    CloseFile(tf);
  end;
  {$IFDEF CONSOLE}
  Writeln(msg);
  {$ENDIF}
end;

initialization
  logThread := TLogThread.Create;

finalization
  logThread.Free;

end.

